home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / insserv / check-archive-initd-scripts next >
Encoding:
Text File  |  2010-05-07  |  8.8 KB  |  276 lines
  1. #!/usr/bin/perl
  2. #
  3. # Check the consistency of all init.d scripts in the archive.  Run
  4. # this on bellini.debian.org.
  5.  
  6. use warnings;
  7. use strict;
  8. use File::Basename;
  9.  
  10. my $warn = 1;
  11.  
  12. my $basedir = "/org/lintian.debian.org/laboratory/binary";
  13.  
  14. my @scripts = @ARGV;
  15. @scripts = <$basedir/*/init.d/*> unless (@scripts);
  16.  
  17. my %scriptinfo;
  18. my %provides;
  19.  
  20. my @virts = qw($local_fs $remote_fs $syslog $time $named
  21.                $portmap $network $all
  22.                $mail-transport-agent $x-font-server
  23.                $null $x-display-manager
  24.                );
  25. my @harddepheaders = qw(required-start required-stop);
  26. my @softdepheaders = qw(should-start
  27.                     should-stop x-start-before x-stop-after);
  28. my $lsbheaders = "Provides|Required-Start|Required-Stop|Default-Start|Default-Stop";
  29. my $optheaders = "x-start-before|x-stop-after|should-start|should-stop";
  30.  
  31. for my $virt (@virts) {
  32.     $provides{$virt} = ['insserv/etc/insserv.conf'];
  33. }
  34.  
  35. # Ignore obsolete scripts, as these are unlikely to cause problems.
  36. for my $old (qw(glibc evms raid2 ldm sdm)) {
  37.     $provides{$old} = ['obsolete'];
  38. }
  39.  
  40. # First pass to load the database
  41. for my $initdscript (@scripts) {
  42.     next if $initdscript =~ m%/rc|/rcS|/README%;
  43.     my %lsbinfo = parse_lsb_header($initdscript);
  44.     $scriptinfo{$initdscript} = \%lsbinfo;
  45.     next unless ($lsbinfo{'found'});
  46.  
  47.     my %checked;
  48.     for my $provide (split(/[ ,\t]+/, $lsbinfo{provides})) {
  49.         if (exists $provides{$provide}) {
  50.             push(@{$provides{$provide}}, $initdscript)
  51.         } else {
  52.             $provides{$provide} = [$initdscript];
  53.         }
  54.         $checked{$provide} = 1;
  55.     }
  56. }
  57.  
  58. for my $provide (sort keys %provides) {
  59.     if (1 < scalar @{$provides{$provide}}) {
  60.         my %script;
  61.         map { $script{basename($_)} = 1; } @{$provides{$provide}};
  62.         if (1 < scalar keys %script) {
  63.             error(sprintf("scripts %s provide duplicate '%s'",
  64.                           join(",", short_name(@{$provides{$provide}})),
  65.                           $provide));
  66.         }
  67.     }
  68. }
  69.  
  70. # Second pass, to see which dependencies are missing
  71. for my $initdscript (@scripts) {
  72.     next unless ($scriptinfo{$initdscript}->{'found'});
  73.     my $short = short_name($initdscript);
  74.     my %checked;
  75.     my @hardmissing = ();
  76.     for my $header (@harddepheaders) {
  77.         my $list = $scriptinfo{$initdscript}->{$header};
  78.         next unless defined $list;
  79.         for my $facility (split(/[ ,\t]+/, $list)) {
  80.             next if exists $checked{$facility};
  81.             $checked{$facility} = 1;
  82.             push(@hardmissing, $facility)
  83.                 unless exists $provides{$facility};
  84.         }
  85.     }
  86.     error("script $short depend on non-existing provides: "
  87.           . join(" ", @hardmissing)) if (@hardmissing);
  88.     my @softmissing = ();
  89.     for my $header (@softdepheaders) {
  90.         my $list = $scriptinfo{$initdscript}->{$header};
  91.         next unless defined $list;
  92.         for my $facility (split(/[ ,\t]+/, $list)) {
  93.             next if exists $checked{$facility};
  94.             $checked{$facility} = 1;
  95.             push(@softmissing, $facility)
  96.                 unless exists $provides{$facility};
  97.         }
  98.     }
  99.     warning("script $short relate to non-existing provides: "
  100.             . join(" ", @softmissing)) if (@softmissing);
  101.  
  102.     if (exists $checked{'$syslog'}
  103.         && $scriptinfo{$initdscript}->{'default-start'} =~ m/s/i) {
  104.         error("script $short depend on \$syslog and start from rcS.d/");
  105.     }
  106.     if (!exists $checked{'$remote_fs'}
  107.         && !exists $checked{'$syslog'}
  108.         && $scriptinfo{$initdscript}->{'need_remote_fs'}
  109.         && $scriptinfo{$initdscript}->{'default-start'} =~ m/s/i) {
  110.         warning("script $short possibly missing dependency on \$remote_fs");
  111.     } elsif (!exists $checked{'$local_fs'}
  112.              && !exists $checked{'$remote_fs'}
  113.              && !exists $checked{'$syslog'}
  114.              && $scriptinfo{$initdscript}->{'need_local_fs'}
  115.              && $scriptinfo{$initdscript}->{'default-start'} =~ m/s/i) {
  116.         warning("script $short possibly missing dependency on \$local_fs");
  117.     }
  118.  
  119.     if (!exists $checked{'$local_fs'}
  120.         && $scriptinfo{$initdscript}->{'need_syslog'}) {
  121.         warning("script $short possibly missing dependency on \$syslog");
  122.     }
  123.  
  124.     my %provided;
  125.     for my $provide (split(/[ ,\t]+/,
  126.                            $scriptinfo{$initdscript}->{provides})) {
  127.         $provided{$provide} = 1;
  128.         if ($provide =~ m/\$/) {
  129.             error("script $short provide virtual facility $provide");
  130.         }
  131.     }
  132.  
  133.     my $basename = basename($initdscript, ".sh");
  134.     info("script $short does not provide its own name")
  135.         unless exists $provided{$basename};
  136.  
  137.     # Detect common problems with runlevel settings.
  138.     my @startrl = sort split(/\s+/, lc($scriptinfo{$initdscript}->{'default-start'}));
  139.     my @stoprl = sort split(/\s+/, lc($scriptinfo{$initdscript}->{'default-stop'}));
  140.  
  141.     unless ( @startrl || @stoprl) {
  142.         error("script $short do not start or stop in any runlevels");
  143.     }
  144.     # Scripts starting in rcS.d/ normally do not stop or only stop
  145.     # during hald and shutdown.
  146.     elsif ((array_equal(['s'], \@startrl) && array_equal([], \@stoprl))
  147.         || ( array_equal(['s'], \@startrl)
  148.              && array_equal(['0','6'], \@stoprl))) {
  149.         # OK
  150.     } else {
  151.         # Most scripts either start in rcS.d, or in runlevels 2-5
  152.         if (!array_equal(['2', '3', '4', '5'], \@startrl) &&
  153.             !array_equal(['s'], \@startrl) &&
  154.             (!array_equal([], \@startrl) && @stoprl)) {
  155.             # Some obvious errors (runlevels 2-5 are equivalent in Debian)
  156.             if (array_equal(['3', '5'], \@startrl)
  157.                 || array_equal(['3', '4', '5'], \@startrl)) {
  158.                 error("script $short have inconsistent start runlevels: ",
  159.                       join(" ", @startrl));
  160.             } else {
  161.                 warning("script $short does not start in the usual runlevels: ",
  162.                         join(" ", @startrl));
  163.             }
  164.         }
  165.  
  166.         # And most scripts stop in runlevel (1) runlevels (0, 1, 6),
  167.         # only starts or only stops in (0) or (6).
  168.         if (!array_equal(['0', '1', '6'], \@stoprl) &&
  169.             !array_equal(['1'], \@stoprl) &&
  170.             !array_equal(['0', '6'], \@stoprl) &&
  171.             !(array_equal(['0'], \@stoprl) && !@startrl) &&
  172.             !(array_equal(['6'], \@stoprl) && !@startrl) &&
  173.             !(array_equal([], \@stoprl) && @startrl)) {
  174.             warning("script $short does not stop in the usual runlevels: ",
  175.                     join(" ", @stoprl));
  176.         }
  177.     }
  178. }
  179.  
  180. exit 0;
  181.  
  182. sub parse_lsb_header {
  183.     my $initdscript = shift;
  184.     my $short = short_name($initdscript);
  185.     my %lsbinfo;
  186.     unless (open(INIT, "<", $initdscript)) {
  187.         error("script $short is unreadable");
  188.         return ();
  189.     }
  190.     my $inheader = 0;
  191.     while (<INIT>) {
  192. #        print;
  193.         chomp;
  194.         if (m/^\#\#\# BEGIN INIT INFO\s*$/) {
  195.             $lsbinfo{'found'} = 1;
  196.             $inheader = 1;
  197.         }
  198.         $inheader = 0 if (m/\#\#\# END INIT INFO$/);
  199.         if ($inheader
  200.             && m/^\# ($lsbheaders|$optheaders):\s*(\S?.*)$/i) {
  201. #            print "$1\n";
  202.             $lsbinfo{lc($1)} = $2;
  203.         }
  204.         s/\#.*$//; # Remove comments
  205.         $lsbinfo{'need_remote_fs'} = 1 if m%/usr/s?bin/%;
  206.         $lsbinfo{'need_local_fs'} = 1 if m%/var/%;
  207.  
  208.         # Detect the use of tools resting in /usr/
  209.         $lsbinfo{'need_remote_fs'} = 1 if m%awk%;
  210.         $lsbinfo{'need_remote_fs'} = 1 if m%which%;
  211.     }
  212.     close(INIT);
  213.  
  214.     # When running on bellini.debian.org, check if $syslog is needed
  215.     my $objdumpinfo = dirname($initdscript) . "/../objdump-info";
  216.     if ( -f $objdumpinfo) {
  217.         print "Checking for syslog symbol\n";
  218.         if (open(OBJDUMP, "<", $objdumpinfo)) {
  219.             while (<OBJDUMP>) {
  220.                 $lsbinfo{'need_syslog'} = 1 if /GLIBC.* syslog/;
  221.             }
  222.             close OBJDUMP;
  223.         }
  224.     }
  225.  
  226.     # Check that all the required headers are present
  227.     if (!$lsbinfo{'found'}) {
  228.         error("script $short is missing LSB header");
  229.     } else {
  230.         for my $key (split(/\|/, lc($lsbheaders))) {
  231.             if (!exists $lsbinfo{$key}) {
  232.                 error("script $short missing LSB keyword '$key'");
  233.             }
  234.         }
  235.     }
  236.     return %lsbinfo
  237. }
  238.  
  239. sub short_name {
  240.     my @scripts;
  241.     for my $script ( @_ ) {
  242.         my $copy = $script;
  243.         $copy =~ s%$basedir/%%g;
  244.         push @scripts, $copy;
  245.     }
  246.     if (wantarray) {
  247.         return @scripts;
  248.     } else {
  249.         return $scripts[0];
  250.     }
  251. }
  252.  
  253. sub array_equal {
  254.     my ($a1, $a2) = @_;
  255.     return 0 if (scalar @{$a1} != scalar @{$a2});
  256.  
  257.     my $i = 0;
  258.     while ($i < scalar @{$a1}) {
  259.         return 0 if $a1->[$i] ne $a2->[$i];
  260.         $i++;
  261.     }
  262.     return 1;
  263. }
  264.  
  265. sub info {
  266.     print "info: @_\n";
  267. }
  268.  
  269. sub warning {
  270.     print "warning: @_\n" if $warn;
  271. }
  272.  
  273. sub error {
  274.     print "error: @_\n";
  275. }
  276.